perm filename MSSIO.FAI[NEW,LCS]9 blob
sn#447711 filedate 1979-06-02 generic text, type T, neo UTF8
00100 TITLE MSSIO ; ********* JUN 8,74 *********
00200 ;; INTERNAL GETFI2,FASTI2,LOOP
00300 INTERNAL GETFI2,FASTI2
00400 INTERNAL LOOK,LOOKD,LOOKF,PAC,UNPAC,LOOKX
00500 INTERNAL PUTEXT,EXTOUT,GETEXT,EXTIN,FINEXT
00600 ; WRITES AND READS DUMP MODE FILES WITH ANY EXTENSION.
00700 ENTRY TYPWRD,TYPSTR,TYPINT,TYPCRLF,TYPFLT,TYPCHR
00800 ;TYPES A WORD, STRING, CRLF, INTEGER, FLTING PT., TYPE CHAR STRING(WD CNT)
00900
01000
01100 CH3←13
01200 CH←12
01300 CH2←11
01400 BLKS←←=1
01500
01600 DEFINE ERROR (MSG)
01700 < JSA 16,.ERROR
01800 JUMP [ASCIZ/MSG/
01900 ]
02000 >
02100
02200
02300 REGS: BLOCK 20
02400 DIR: BLOCK 4
02500
02600 ;CALL PUTEXT(<FILE>,<EXT>)
02700 PUTEXT: 0 ;USES EXTOUT,FINEXT, CH2
02800 MOVE 0,@0(16)
02900 MOVEM 0,FILNAM
03000 MOVE 0,@1(16)
03100 MOVEM 0,EXTNAM
03200 JSA 16,INTFIL
03300 SETZM DIR+2
03400 SETZM DIR+3
03500 ENTER CH2,DIR
03600 ERROR <ENTER FAILED>
03700 JRA 16,2(16)
03800
03900 ;CALL EXTOUT(<ARRAY>,<NO. OF WORDS>)
04000
04100 EXTOUT: 0
04200 HRRZ 0,0(16)
04300 SUBI 0,1
04400 MOVEM 0,COM
04500 MOVN 0,@1(16)
04600 HRLM 0,COM
04700 OUTPUT CH2,COM
04800 STATZ CH2,740000
04900 ERROR <WRITE ERROR>
05000 JRA 16,2(16)
05100
05200
05300 INTFIL: 0 ;INITS DSK
05400 MOVEI REGS
05500 BLT REGS+3
05600 INIT CH2,17
05700 SIXBIT/DSK/
05800 0
05900 ERROR <CAN'T INIT DSK!>
06000 INTF4: MOVE 0,FILNAM#
06100 MOVEM 0,FN#
06200 MOVE 1,[POINT 7,FN]
06300 INTF3: MOVE 2,[POINT 6,DIR]
06400 SETZM DIR
06500 MOVEI 3,5
06600 INTF1: ILDB 0,1
06700 CAIN 0," "
06800 JRST INTF2
06900 SUBI 0,40
07000 IDPB 0,2
07100 SOJG 3,INTF1
07200 INTF2: HRLZI REGS
07300 BLT 3
07400 MOVE 0,EXTNAM#
07500 MOVEM 0,EX#
07600 MOVE 1,[POINT 7,EX]
07700 EXTF3: MOVE 2,[POINT 6,DIR+1]
07800 SETZM DIR+1
07900 MOVEI 3,5
08000 EXTF1: ILDB 0,1
08100 CAIN 0," "
08200 JRST EXTF2
08300 SUBI 0,40
08400 IDPB 0,2
08500 SOJG 3,EXTF1
08600 EXTF2: HRLZI REGS
08700 BLT 3
08800 JRA 16,0(16)
08900
09000
09100 COM: OCT 0,0
09200 BLKNUM: 0
09300
09400 ;CALL FINEXT
09500 FINEXT: 0
09600 CLOSE CH2,0
09700 STATZ CH2,740000
09800 ERROR <ERROR AFTER CLOSE>
09900 RELEASE CH2,0
10000 JRA 16,0(16)
10100
10200 ;CALL GETEXT(<FILE>,<EXT>)
10300
10400 GETEXT: 0
10500 MOVE 0,@0(16)
10600 MOVEM 0,FILNAM
10700 MOVE 0,@1(16)
10800 MOVEM 0,EXTNAM
10900 JSA 16,INTFX
11000 SETZM DIR+3
11100 SETZM DIR+2
11200 LOOKUP CH,DIR
11300 ERROR <LOOKUP FAILED>
11400 JRA 16,2(16)
11500
11600
11700 INTFX: 0 ;INITS DSK FOR INPUT
11800 MOVEI REGS
11900 BLT REGS+3
12000 INIT CH,17
12100 SIXBIT/DSK/
12200 0
12300 ERROR <CAN'T INIT DSK!>
12400 JRST INTF4
12500
12600
12700 ;CALL FASTI2(<ARRAY>,<NO. WORDS>)
12800
12900 EXTIN: 0
13000 HRRZ 0,0(16)
13100 SUBI 0,1
13200 MOVEM 0,COM
13300 MOVN 0,@1(16)
13400 HRLM 0,COM
13500 INPUT CH,COM
13600 STATZ CH,740000
13700 0
13800 JRA 16,2(16)
13900 .ERROR: 0
14000 OUTSTR [ASCIZ/?
14100 /] ;MAKE SURE HE CAN SEE HIS ERROR
14200 OUTSTR @(16) ;OUTPUT ERROR MESSAGE
14300 CALLI 1,12 ;LET USER CONTINUE
14400 JRA 16,1(16)
14500 ;CALL GETFI2(<FILE>,<0 OR -1>) 0=DAT,LCS -1=WHERE YOU ARE., -2=MSS,MUS(HELP)
14600
14700 GETFI2: 0
14800 MOVE 0,@0(16)
14900 MOVEM 0,FILNAM
15000 MOVE 0,@1(16)
15100 MOVEM 0,PPNW#
15200 JSA 16,INTFIZ
15300 MOVE 0,[SIXBIT/DMD/]
15400 MOVEM 0,DIR+1
15500 JSA 16,LKUP
15600 SKIPA
15700 JRST GETF3
15800 SETZM DIR+1
15900 JSA 16,LKUP
16000 SKIPA
16100 GETF3: JRA 16,2(16)
16200 MOVEI 1
16300 MOVEM @1(16) ;SEND BACK A 1 IN 2ND ARGUMENT IF FILE NOT FOUND.
16400 JRA 16,2(16)
16500
16600 LKUP: 0
16700 SETZM DIR+2
16800 SETZM DIR+3
16900 SKIPE PPNW ;0=DAT,LCS NON-ZERO = WHERE EVER YOU ARE
17000 JRST LUP
17100 MOVE 0,[SIXBIT/DATLCS/]
17200 JRST LUP3
17300 LUP: MOVN 0,PPNW
17400 CAIE 0,2 ;-2=MSS,MUS
17500 JRST LUP2
17600 MOVE 0,[SIXBIT/MSSMUS/]
17700 LUP3: MOVEM 0,DIR+3 ;PUTS AWAY THE PPN
17800 LUP2: LOOKUP CH3,DIR
17900 JRA 16,0(16)
18000 JRA 16,1(16)
18100
18200 INTFIZ: 0 ;INITS DSK FOR INPUT
18300 MOVEI REGS
18400 BLT REGS+3
18500 INIT CH3,17
18600 SIXBIT/DSK/
18700 0
18800 ERROR <CAN'T INIT DSK!>
18900 JRST INTF4
19000
19100
19200 ;CALL FASTI2(<ARRAY>,<NO. WORDS>)
19300
19400 FASTI2: 0
19500 HRRZ 0,0(16)
19600 SUBI 0,1
19700 MOVEM 0,COM
19800 MOVN 0,@1(16)
19900 HRLM 0,COM
20000 INPUT CH3,COM
20100 STATZ CH3,740000
20200 0
20300 JRA 16,2(16)
00100
00200 ;LOOK(<FILE>) FOR NO EXT., LOOKD() FOR .DAT, LOOKF() FOR .DMD, LOOKX FOR (.EXT)
00300
00400 LOOKX: 0
00500 MOVE 0,@1(16)
00600 MOVEM 0,FILNAM
00700 JSA 16, INTFIQ
00800 MOVE 0,DIR
00900 JRST LOOK1
01000 LOOKF: 0
01100 MOVSI 0,'DMD'
01200 JRST LOOK1
01300 LOOKD: 0
01400 MOVSI 0,'DAT'
01500 JRST LOOK1
01600 LOOK: 0
01700 MOVEI 0,0
01800 LOOK1: MOVEM 0,DIR+1
01900 MOVE 0,@(16)
02000 MOVEM 0,FILNAM
02100 JSA 16, INTFIQ
02200 SETZM DIR+2
02300 SETZM DIR+3
02400 LOOKUP CH,DIR
02500 TDZA 0,0
02600 MOVNI 0,1
02700 JRA 16,1(16)
02800
02900 INTFIQ: 0 ;INITS DSK FOR INPUT
03000 MOVEI REGS
03100 BLT REGS+3
03200 INIT CH,17
03300 SIXBIT/DSK/
03400 0
03500 HALT .-3
03600 ; ERROR <CAN'T INIT DSK!>
03700
03800 ;;INTF4: MOVE 0,FILNAM#
03900 ;; MOVEM 0,FN#
04000 ;; MOVE 1,[POINT 7,FN]
04100 MOVE 1,[POINT 7,FILNAM#]
04200 MOVE 2,[POINT 6,DIR]
04300 SETZM DIR
04400 MOVEI 3,5
04500 INTL1: ILDB 0,1
04600 ;; CAIN 0," "
04700 ;; JRST INTF2
04800 SUBI 0,40
04900 IDPB 0,2
05000 SOJG 3,INTL1
05100 INTL2: HRLZI REGS
05200 BLT 3
05300 JRA 16,0(16)
05400
05500 PAC: 0 ;CALL PAC(PW,AR)
05600 HRRZ 4,1(16) ; ******* USES AC'S 4,5,6 ********
05700 ADDI 4,2
05800 HRR 5,@4 ;SIZE IS 12 BITS
05900 LSHC 5,-10
06000 SOJ 4,
06100 HRR 5,@4
06200 LSHC 5,-16
06300 SOJ 4,
06400 HRR 5,@4
06500 LSHC 5,-16
06600 MOVEM 6,@0(16)
06700 JRA 16,2(16)
06800 UNPAC: 0 ;CALL UNPAC(PW,AR)
06900 HRRZ 1,1(16)
07000 ADDI 1,2
07100 MOVE 2,@0(16)
07200 LSHC 2,-10
07300 ASH 3,-34
07400 MOVEM 3,@1
07500 SOJ 1,
07600 LSHC 2,-16
07700 ASH 3,-26
07800 MOVEM 3,@1
07900 SOJ 1,
08000 LSHC 2,-16
08100 ASH 3,-26
08200 MOVEM 3,@1
08300 JRA 16,2(16)
08400
08500 TYPSTR: 0 ;CALL TYPSTR(STRING)
08600 OUTSTR @(16) ;TYPES OUT A STRING
08700 JRA 16,1(16) ;THIS WILL TYPE IN GROUPS OF 5 CHARS ALWAYS!!!
08800
08900 TYPCHR: 0 ;CALL TYPCHR(STRING,CHAR COUNT)
09000 SKIPL 1,@1(16)
09100 JRST TYPCH2
09200 OUTSTR @(16)
09300 TYPCH1: JRA 16,2(16)
09400 TYPCH2: MOVSI 2,440700
09500 HRRI 2,@(16)
09600 TYPCH3: SOJL 1,TYPCH1
09700 ILDB 3,2
09800 OUTCHR 3
09900 JRST TYPCH3
10000
10100 TYPWRD: 0 ;CALL TYPWRD(WORD) ASSUMES ≤5 CHARS.
10200 MOVSI 2,440700
10300 HRRI 2,@(16)
10400 MOVEI 1,5
10500 TYPWR1: ILDB 3,2
10600 OUTCHR 3
10700 SOJG 1,TYPWR1
10800 JRA 16,1(16)
10900
11000 TYPCRLF: 0 ;CALL TYPCRLF TYPES A CRLF
11100 OUTSTR [ASCIZ /
11200 /]
11300 JRA 16,(16)
11400
11500 TYPINT: 0 ;CALL TYPINT(INTEGER)
11600 SKIPGE 1,@(16) ;TYPES OUT INTEGERS
11700 OUTCHR ["-"]
11800 MOVMS 1
11900 PUSHJ 17,DECREC
12000 JRA 16,1(16)
12100 DECREC: IDIVI 1,=10
12200 HRLM 2,(17)
12300 SKIPE 1
12400 PUSHJ 17,DECREC
12500 HLRZ 1,(17)
12600 ADDI 1,"0"
12700 OUTCHR 1
12800 POPJ 17,
12900
13000 TYPFLT: 0 ;CALL TYPFLT(F)
13100 MOVM 4,@(16) ;NEEDS ACS 1→5 **** PRINTS ONLY TO 2 DECIS.
13200 KIFIX 3,@(16)
13300 FMPR 4,[100.0] ;TO GET THINGS TO RT. OF DEC.
13400 ;;*** CAUSES 199.997 TO PRINT AS 199 ** FADR 4,[0.5] ;FOR ROUND OFF.
13500 KIFIX 4,4
13600 IDIVI 4,=100 ;REMAINDER IS IN AC6
13700 JUMPN 3,TYPFL1 ;JUMP IF LFT SIDE .NE.0
13800 SKIPGE @(16) ;IS ORIGINAL NUM. NEG?
13900 OUTCHR ["-"] ;YES
14000 OUTCHR ["0"]
14100 JRST .+3 ;PRINT A ZERO AND SKIP NEXT CALL
14200 TYPFL1: JSA 16,TYPINT
14300 JUMP 3
14400 SKIPN 5 ;PRINT NO MORE IF ONLY ZEROS
14500 JRA 16,1(16)
14600 OUTCHR ["."] ;DECIMAL PT.
14700 ;; CAIGE 5,=100
14800 ;; OUTCHR["0"] ;FOR ZERO AFTER DECI
14900 CAIGE 5,=10
15000 OUTCHR["0"] ;FOR ZERO AFTER DECI
15100 ;; MOVE 3,5
15200 ;; IDIVI 3,=100
15300 ;; JUMPE 4,DECI ;LOOK AT REMAINDER, JUMP IF NON-ZERO
15400 MOVE 3,5
15500 IDIVI 3,=10
15600 SKIPE 4 ;LOOK AT REMAINDER, JUMP IF NON-ZERO
15700 MOVE 3,5 ;ELSE PRINT ALL 3 DIGITS
15800 DECI: JSA 16,TYPINT
15900 JUMP 3
16000 JRA 16,1(16)
16100
16200 END